<--- %%NOBANNER%% --> _ranperm.sas
 BackForward

/*-------------------<-- Start of Description -->--------------------\
| Generate random variates from a permutation;                       |
|--------------------<--- End of Description -->---------------------|
|--------------------------------------------------------------------|
|--------------<--- Start of Files or Arguments Needed -->-----------|
| Argument Required:                                                 |
|    seed - seed; default is the current system time;                |
|     var - the name of the output variable or output array name to  |
|           save the generated variates;                             |
|       n - the size of the array to be generated;                   |
|    init - this function is being used the 1st time in the current  |
|           data step or not? default is 1: declare an array for use;|
|           otherwise: do not declare the array, since it has alreay |
|           been declared earlier;                                   |
|---------------<--- End of Files or Arguments Needed -->------------|
|--------------------------------------------------------------------|
|----------------<--- Start of Example and Usage -->-----------------|
| Example:                                                           |
|    data one;                                                       |
        do i=1 to 200;                                               |
|          %_ranperm(seed=1, var=x, n=7);                            |
|          output;                                                   |
|       end;                                                         |
|		%_ranperm(seed=_ranperm0_, var=x, n=7, init=0); 			 |
|		output;														 |
|    run;proc print data=one; run;                                   |
| Usage: %_ranperm(seed=%sysfunc(datetime(), 15.), var=, n=, init=1);|
\-------------------<--- End of Example and Usage -->---------------*/
%macro _ranperm(seed=%sysfunc(datetime(), 15.), var=, n=, init=1, 
				temp=_ranperm0_);
/*--------------------------------------------\
| Author:  Duo Zhou;                          |
| Created: 3-22-2002 9:30pm;                  |
| Purpose: Generate random variates from a    |
|          permutation;                       |
\--------------------------------------------*/
%local i; %global _ranpermjobid; 
%if (%quote(&_ranpermjobid) ne ) %then %let _ranpermjobid=%eval(&_ranpermjobid+1);
%else %let _ranpermjobid=0;
%if (%quote(&seed) eq) or (%quote(&var) eq) or (%quote(&n) eq)  %then %do;
  %if (%quote(&seed) eq) %then %do;
     %put ==> Error: This is not a valid seed!; 
     %if (%length(&var)) %then %do; &var=.; %end;
  %end;
  %if (%quote(&var) eq) %then %do;
     %put ==> Error: This function will need a valid array to save the generated random;
     %put +++        variates!; 
     %if (%length(&var)) %then %do; &var=.; %end;
  %end;
  %if (%quote(&n) eq) %then %do;
     %put ==> Error: I will save the generated random variates into the array "&var", so;
     %put +++        please provide array dimension !; 
     %if (%length(&var)) %then %do; &var=.; %end;
  %end;
  %goto finish;
%end;     
%else %do;
   %if (not %sysfunc(rxmatch(%sysfunc(rxparse(_|.|$a|$A|$w)),&seed))) %then %do;
      drop &temp;
      retain &temp &seed;
      %let seed=&temp;
   %end;
   %if (&init) or (%index(%quote(%upcase(&init)), T)) %then %do;
       drop ranperm1 ranperm2 ranperm3;
       array _ranperm(&n) _temporary_;
	   array &var(&n) &var.1 - &var.%left(&n);
   %end;
   do ranperm1=1 to &n;
      _ranperm(ranperm1)=ranperm1;
   end;
   %_rantbl(seed=&seed, var=ranperm2, n=&n, init=&init);
   ranperm1=&n;
       &var(ranperm1)=_ranperm(ranperm2);
       do ranperm3=ranperm2 to ranperm1-1;
           _ranperm(ranperm3)=_ranperm(ranperm3+1);
       end;
       _ranperm(ranperm1)=0;    
   %do i=&n-1 %to 2 %by -1;
      do until(ranperm1<&n);
         %_rantbl(seed=&seed, var=ranperm2, n=&i, init=0); 
         ranperm1=&i;
         &var(ranperm1)=_ranperm(ranperm2);
         do ranperm3=ranperm2 to ranperm1-1;
            _ranperm(ranperm3)=_ranperm(ranperm3+1);
         end;
         _ranperm(ranperm1)=0;    
	  end;
   %end;
   &var(1)=_ranperm(1);
%end;
%finish:
%mend _ranperm;